perm filename OUR.COR[UCI,SYS] blob
sn#073819 filedate 1973-11-22 generic text, type T, neo UTF8
-!ILISP.MACāUCILSP.MAC
-2,2
TITLE ILISP INTERPRETER
-6,7
-26,26
DEFINE SYSNAM <SIXBIT /ILISP2/> ; *** MJC
-178,186
; CAME 0,STNIL ;$$UNBIND STACK IF REGS LOOK OK *** MJC
; JRST GETHGH ;GO GET HIGH SEGMENT *** MJC
; MOVE B,SC2 *** MJC
; PUSHJ P,UBD ;$$UNBIND STACK *** MJC
; JRST STRT ;go to re-allocator *** MJC
;GETHGH: CALLI RESET *** MJC
; MOVSI A,1 *** MJC
;IFE STANSW,< CALLI A,CORE ;ELIMINATE ANY OLD HIGH SEGS. *** MJC
; HALT > *** MJC
-192,200
MOVE A,HGHDAT+1 ; Get high segment name *** MJC
CALLI A,400016 ; Attach to high seg if poss. *** MJC
CAIN A,4 ; If err=4 (seg alrdy there) ok too *** MJC
JRST SGPROT ; Success! *** MJC
CALLI 400017 ; Detach stray segments. *** MJC
MOVE A,HGHDAT ; Get device name for OPEN. *** MJC
MOVEM A,INTDAT+1 ; Move into parm list for OPEN. *** MJC
OPEN 0,INTDAT ; Init ch 0 to dump mode. *** MJC
JRST NOSEG ; Couldn't do it? *** MJC
MOVE A,SGPPPN ; Get ppn of high seg file. *** MJC
MOVEM A,HGHDAT+4 ; Store for LOOKUP. *** MJC
LOOKUP 0,HGHDAT+1 ; Find file containing high seg *** MJC
JRST NOSEG ; No high seg file -- collapse *** MJC
HLRE A,HGHDAT+4 ; Ppn was replaced by -length *** MJC
MOVNS A ; Fix up for CORE2. *** MJC
CALLI A,400015 ; Grab core for high segment. *** MJC
JRST NOSEG ; Can't get it? *** MJC
MOVE A,HGHDAT+1 ; Name the high segment. *** MJC
CALLI A,400036 ; SEGNM2 uuo. *** MJC
JRST NOSEG ; Pretty weird. *** MJC
MOVEI A,SHRST-1 ; For dump mode input. *** MJC
HRRM A,HGHDAT+4 ; *** MJC
INPUT 0,HGHDAT+4 ; Fill high seg with goodies. *** MJC
CLOSE 0,1 ; Destroy fingerprints. *** MJC
SGPROT: MOVEI A,DEBUGO ;SET THE REE ADDRESS
HRRM A,JOBREN
MOVE A,HGHDAT+1 ; Decide whether or not to *** MJC
CAME A,[SYSNAM] ; protect segment. *** MJC
JRST STRT ; Segment was not system's *** MJC
CALLI 36 ; Write-protect segment. *** MJC
HALT ; rather than turn him loose. *** MJC
JRST STRT ;GO TO ALLOCATE STORAGE
NOSEG: OUTSTR [ASCIZ/CAN'T GET HIGH SEGMENT!/] ; *** MJC
HALT ; *** MJC
HGHDAT: SYSDEV ; All used by LOOKUP and ENTER *** MJC
SYSNAM ; High segment job & file name *** MJC
0 ; High seg file extension. *** MJC
0
0 ; PRG,PPN of high seg file. *** MJC
; Also file length after LOOKUP *** MJC
; Used as dump wd cmd list. *** MJC
0
INTDAT: 17 ; Data mode. *** MJC
SYSDEV ; Dev name (defd before OPEN) *** MJC
0 ; Buffer indicators (none) *** MJC
SGPPPN: XWD SYSPRG,SYSPN ; High seg file area *** MJC
PATCHL: BLOCK 20
>
-201:
-5049,5049
NAME: SIXBIT/ILISP/
-5158,5163
CAME A,[SYSNAM] ; *** MJC
; We're not allowing him to name his segment the same as ours, *** MJC
; since that causes problems for ATTSEG, so test for it. *** MJC
JRST GUDSEG ; *** MJC
MOVE B,[SYSDEV] ; But if he's a system hacker *** MJC
CAME B,DEV ; then we let him get away *** MJC
JRST BADSEG ; with it. *** MJC
GUDSEG: MOVEM A,HGHDAT+1 ;SAVE THE FILE NAME
MOVE A,DEV ;GET THE DEVICE AND SAVE IT
MOVEM A,HGHDAT
MOVEM A,INTDAT+1 ; Save it for OPEN, too. *** MJC
MOVE A,PPN ;GET THE PPN AND SAVE IT
MOVEM A,SGPPPN ; *** MJC
MOVEM A,HGHDAT+4
SKIPN A,EXT ; Get extension and save it. *** MJC
MOVE A,[SIXBIT/SEG/] ; No ext -- use SEG instead. *** MJC
MOVEM A,HGHDAT+2 ; Move ext into OPEN stuff. *** MJC
OPEN 0,INTDAT ; Open for dump output. *** MJC
JRST BADSEG ; Couldn't open? *** MJC
ENTER 0,HGHDAT+1 ; Hookup to file. *** MJC
JRST BADSEG ; Couldn't do it? *** MJC
CALLI A,400022 ; Find size of high segment. *** MJC
MOVNS A ; Construct dump mode cmd wd. *** MJC
HRLM A,HGHDAT+4 ; I.e. -length to left half *** MJC
MOVEI A,SHRST-1 ; and <start>-1 to rt half. *** MJC
HRRM A,HGHDAT+4 ; *** MJC
OUTPUT 0,HGHDAT+4 ; *** MJC
CLOSE 0,2 ; Leave no traces *** MJC
JRST FALSE ;RETURN NIL
BADSEG: ERR1 [SIXBIT/ILLEGAL NAME FOR SEGMENT!/] ; *** MJC
JRST FALSE ; *** MJC